home *** CD-ROM | disk | FTP | other *** search
/ Aminet 3 / Aminet 3 - July 1994.iso / Aminet / dev / m2 / Modules.lha / Modules / GraphicsSupport / GraphicsSupport.mod / GraphicsSupport.mod
Encoding:
Modula Implementation  |  1993-12-22  |  55.5 KB  |  2,272 lines
  1. IMPLEMENTATION MODULE GraphicsSupport;
  2.  
  3. (* Die Erklärung der Funktionen und Hinweise befinden sich im Definitionsfile *)
  4. (* Compiler : M2Amiga 4.097d                         © 1991 by Andre Wiethoff *)
  5.  
  6.  
  7. (*$ StackChk:=FALSE *)
  8. (*$ RangeChk:=FALSE *)
  9. (*$ OverflowChk:=FALSE *)
  10. (*$ NilChk:=FALSE *)
  11. (*$ CaseChk:=FALSE *)
  12. (*$ ReturnChk:=FALSE *)
  13. (*$ Volatile:=FALSE *)
  14. (*$ StackParms:=FALSE *)
  15. (*$ LargeVars:=FALSE *)
  16.  
  17.  
  18. FROM SYSTEM       IMPORT ADR,ADDRESS,BITSET,SHORTSET,CAST,REG,SETREG,
  19.                          ASSEMBLE,LONGSET,FFP;
  20. FROM FileSystem   IMPORT File,WriteBytes,ReadBytes;
  21. FROM GraphicsD    IMPORT SimpleSprite,SimpleSpritePtr,BitMap,spriteAttached,
  22.                          VSprite,VSpritePtr,Bob,BobPtr,VSpriteFlags,BitMapPtr,
  23.                          VSpriteFlagSet,BobFlags,BobFlagSet,GelsInfo,AnimOb,
  24.                          GelsInfoPtr,CollTable,GfxBasePtr,RastPortPtr,AnimComp,
  25.                          ViewPortPtr,DBufPacket,View,ViewPort,ViewPtr,ViewModes,
  26.                          RastPort,RasInfo,ColorMap,ViewModeSet,AnimObPtr,
  27.                          AreaInfoPtr,RastPortFlags,RastPortFlagSet,AnimCompPtr,
  28.                          ringtrigger,ColorMapFlagSet,DrawModes,DrawModeSet;
  29. FROM GraphicsL    IMPORT GetSprite,FreeSprite,MoveSprite,BltBitMap,SetRast,
  30.                          ChangeSprite,AddVSprite,RemVSprite,AddBob,InitGels,
  31.                          SortGList,DrawGList,InitMasks,DoCollision,SetRGB4,
  32.                          SetCollision,RemIBob,LoadView,MrgCop,MakeVPort,
  33.                          InitView,InitVPort,InitRastPort,InitBitMap,Text,
  34.                          LoadRGB4,FreeVPortCopLists,FreeCprList,WaitTOF,
  35.                          InitArea,AreaEnd,AreaMove,AreaDraw,InitTmpRas,
  36.                          AreaEllipse,SetAPen,Move,Draw,AllocRaster,Flood,
  37.                          FreeRaster,AddAnimOb,Animate,WaitBOVP,SetDrMd;
  38. FROM GfxMacros    IMPORT AreaCircle,SetOPen,RemBob;
  39. FROM IntuitionL   IMPORT RemakeDisplay;
  40. FROM ExecL        IMPORT TypeOfMem,CopyMem,FindTask;
  41. FROM ExecD        IMPORT MemReqSet,MemReqs,Task,TaskPtr;
  42. FROM MathTrans    IMPORT Sin,Cos;
  43. FROM RememberHeap IMPORT NewAllocRemember,NewFreeRemember,NewRememberPtr,
  44.                          CutRememberStructure,GetAddress;
  45. FROM Hardware     IMPORT custom,CollisionControlFlags,CollisionFlags,
  46.                          CollisionControlFlagSet,CollisionFlagSet;
  47. FROM String       IMPORT Length;
  48. IMPORT GraphicsL;
  49.  
  50.  
  51.  
  52. CONST notAdded = 0;
  53.       bobAdded = 1992;
  54.  
  55. TYPE NewBobPtr = POINTER TO RECORD
  56.                    bob  : Bob;
  57.                    user : LONGINT;
  58.                  END;
  59.  
  60. VAR rememberView   : NewRememberPtr;
  61.     rememberBitmap : NewRememberPtr;
  62.     rememberData   : NewRememberPtr;
  63.     gfxBase        : GfxBasePtr;
  64.  
  65.  
  66. PROCEDURE CopyToChip(data  : ADDRESS;
  67.                      count : LONGINT) : ADDRESS;
  68. VAR adr : ADDRESS;
  69. BEGIN
  70.   IF (data#NIL) AND (count#0) THEN
  71.     IF (NOT (chip IN TypeOfMem(data))) OR (count<0) THEN
  72.       count:=ABS(count);
  73.       adr:=NewAllocRemember(rememberData,count,TRUE);
  74.       IF adr#NIL THEN
  75.         CopyMem(data,adr,count);
  76.       END;
  77.       RETURN adr;
  78.     ELSE
  79.       RETURN data;
  80.     END;
  81.   END;
  82. END CopyToChip;
  83.  
  84.  
  85.  
  86. PROCEDURE FreeChipData(VAR data : ADDRESS);
  87. BEGIN
  88.   IF data#NIL THEN
  89.     CutRememberStructure(rememberData,data,TRUE);
  90.     data:=NIL;
  91.   END;
  92. END FreeChipData;
  93.  
  94.  
  95.  
  96. PROCEDURE GetBitMap(width,height : INTEGER;
  97.                     depth        : INTEGER) : BitMapPtr;
  98. VAR b   : BitMapPtr;
  99.     err : BOOLEAN;
  100.     t   : INTEGER;
  101. BEGIN
  102.   b:=NIL;
  103.   b:=NewAllocRemember(rememberBitmap,SIZE(BitMap),FALSE);
  104.   IF b#NIL THEN
  105.     InitBitMap(b^,depth,width,height);
  106.     err:=FALSE;
  107.     FOR t:=0 TO depth-1 DO
  108.       b^.planes[t]:=NewAllocRemember(rememberData,
  109.                     (((width-1) DIV 8)+1)*height,TRUE);
  110.       err:=err OR (b^.planes[t]=NIL);
  111.     END;
  112.     IF err THEN
  113.       FOR t:=0 TO 7 DO
  114.         IF b^.planes[t]#NIL THEN
  115.           CutRememberStructure(rememberData,b^.planes[t],TRUE);
  116.         END;
  117.       END;
  118.       CutRememberStructure(rememberBitmap,b,TRUE);
  119.       b:=NIL;
  120.     END;
  121.   END;
  122.   RETURN b;
  123. END GetBitMap;
  124.  
  125.  
  126.  
  127. PROCEDURE FreeBitMap(VAR bitMap : BitMapPtr);
  128. VAR t : INTEGER;
  129. BEGIN
  130.   IF bitMap#NIL THEN
  131.     FOR t:=0 TO 7 DO
  132.       IF bitMap^.planes[t]#NIL THEN
  133.         CutRememberStructure(rememberData,bitMap^.planes[t],TRUE);
  134.       END;
  135.     END;
  136.     CutRememberStructure(rememberBitmap,bitMap,TRUE);
  137.     bitMap:=NIL;
  138.   END;
  139. END FreeBitMap;
  140.  
  141.  
  142.  
  143. PROCEDURE GetRastPort(bitmap : BitMapPtr) : RastPortPtr;
  144. VAR rp : RastPortPtr;
  145. BEGIN
  146.   rp:=NewAllocRemember(rememberData,SIZE(RastPort),FALSE);
  147.   IF rp#NIL THEN
  148.     InitRastPort(rp^);
  149.     rp^.bitMap:=bitmap;
  150.   END;
  151.   RETURN rp;
  152. END GetRastPort;
  153.  
  154.  
  155.  
  156. PROCEDURE FreeRastPort(VAR rp : RastPortPtr);
  157. BEGIN
  158.   IF rp#NIL THEN
  159.     CutRememberStructure(rememberData,rp,TRUE);
  160.     rp:=NIL;
  161.   END;
  162. END FreeRastPort;
  163.  
  164.  
  165.  
  166. PROCEDURE GetView(width,height : INTEGER;
  167.                   depth        : INTEGER;
  168.                   modes        : ViewModeSet;
  169.                   colors       : ADDRESS) : ViewHandlePtr;
  170. VAR vh  : ViewHandlePtr;
  171.     t   : INTEGER;
  172.     err : BOOLEAN;
  173. BEGIN
  174.   vh:=NewAllocRemember(rememberView,SIZE(ViewHandle),FALSE);
  175.   IF vh#NIL THEN
  176.     WITH vh^ DO
  177.       InitView(view);
  178.       InitVPort(viewPort);
  179.       InitRastPort(rastPort);
  180.       InitBitMap(bitMap,depth,width,height);
  181.       err:=FALSE;
  182.       FOR t:=0 TO depth-1 DO
  183.         bitMap.planes[t]:=NewAllocRemember(rememberData,
  184.                           (((width-1) DIV 8)+1)*height,TRUE);
  185.         err:=err OR (bitMap.planes[t]=NIL);
  186.       END;
  187.       colorMap.colorTable:=NewAllocRemember(rememberData,64*2,TRUE);
  188.       err:=err OR (colorMap.colorTable=NIL);
  189.       IF NOT err THEN
  190.         view.viewPort:=ADR(viewPort);
  191.         view.modes:=modes;
  192.         viewPort.dWidth:=width;
  193.         viewPort.dHeight:=height;
  194.         viewPort.modes:=modes;
  195.         viewPort.rasInfo:=ADR(rasInfo);
  196.         viewPort.colorMap:=ADR(colorMap);
  197.         colorMap.flags:=ColorMapFlagSet{};
  198.         colorMap.type:=0;
  199.         colorMap.count:=64;
  200.         rasInfo.bitMap:=ADR(bitMap);
  201.         rasInfo.rxOffset:=0;
  202.         rasInfo.ryOffset:=0;
  203.         rasInfoDBPF.bitMap:=NIL;
  204.         rastPort.bitMap:=ADR(bitMap);
  205.         IF colors#NIL THEN
  206.           LoadRGB4(ADR(viewPort),colors,32);
  207.         END;
  208.         MakeVPort(ADR(view),ADR(viewPort));
  209.         MrgCop(ADR(view));
  210.       ELSE
  211.         IF colorMap.colorTable#NIL THEN
  212.           CutRememberStructure(rememberData,colorMap.colorTable,TRUE);
  213.         END;
  214.         FOR t:=0 TO 7 DO
  215.           IF bitMap.planes[t]#NIL THEN
  216.             CutRememberStructure(rememberData,bitMap.planes[t],TRUE);
  217.           END;
  218.         END;
  219.         CutRememberStructure(rememberView,vh,TRUE);
  220.       END;
  221.     END;
  222.   END;
  223.   RETURN vh;
  224. END GetView;
  225.  
  226.  
  227.  
  228. PROCEDURE MakePlayfield(view   : ViewHandlePtr;
  229.                         bitmap : BitMapPtr);
  230. BEGIN
  231.   IF (view#NIL) AND (bitmap#NIL) THEN
  232.     view^.rasInfoDBPF.bitMap:=bitmap;
  233.     view^.rasInfoDBPF.rxOffset:=0;
  234.     view^.rasInfoDBPF.ryOffset:=0;
  235.     view^.rasInfo.next:=ADR(view^.rasInfoDBPF);
  236.   END;
  237. END MakePlayfield;
  238.  
  239.  
  240.  
  241. PROCEDURE SetPlayfieldPriority(view : ViewHandlePtr;
  242.                                b    : BOOLEAN);
  243. BEGIN
  244.   IF view#NIL THEN
  245.     IF b THEN
  246.       INCL(view^.viewPort.modes,pfba);
  247.       INCL(view^.view.modes,pfba);
  248.     ELSE
  249.       EXCL(view^.viewPort.modes,pfba);
  250.       EXCL(view^.view.modes,pfba);
  251.     END;
  252.   END;
  253. END SetPlayfieldPriority;
  254.  
  255.  
  256.  
  257. PROCEDURE SetViewPosition(view  : ViewHandlePtr;
  258.                           px,py : INTEGER);
  259. BEGIN
  260.   IF view#NIL THEN
  261.     view^.view.dyOffset:=py;
  262.     view^.view.dxOffset:=px;
  263.   END;
  264. END SetViewPosition;
  265.  
  266.  
  267.  
  268. PROCEDURE MoveView(view  : ViewHandlePtr;
  269.                    dx,dy : INTEGER);
  270. BEGIN
  271.   IF view#NIL THEN
  272.     INC(view^.rasInfo.rxOffset,dx);
  273.     INC(view^.rasInfo.ryOffset,dy);
  274.   END;
  275. END MoveView;
  276.  
  277.  
  278.  
  279. PROCEDURE MovePlayfield(view  : ViewHandlePtr;
  280.                         dx,dy : INTEGER);
  281. BEGIN
  282.   IF view#NIL THEN
  283.     IF view^.rasInfoDBPF.bitMap#NIL THEN
  284.       INC(view^.rasInfoDBPF.rxOffset,dx);
  285.       INC(view^.rasInfoDBPF.ryOffset,dy);
  286.     END;
  287.   END;
  288. END MovePlayfield;
  289.  
  290.  
  291.  
  292. PROCEDURE GetPlayfieldPos(vh        : ViewHandlePtr;
  293.                           VAR vx,vy : INTEGER;
  294.                           VAR px,py : INTEGER);
  295. BEGIN
  296.   IF vh#NIL THEN
  297.     vx:=vh^.rasInfo.rxOffset;
  298.     vy:=vh^.rasInfo.ryOffset;
  299.     px:=vh^.rasInfoDBPF.rxOffset;
  300.     py:=vh^.rasInfoDBPF.ryOffset;
  301.   END;
  302. END GetPlayfieldPos;
  303.  
  304.  
  305.  
  306. PROCEDURE SetView(view : ViewHandlePtr);
  307. BEGIN
  308.   IF view#NIL THEN
  309.     IF gfxBase^.actiView#ADR(view^.view) THEN
  310.       view^.oldView:=gfxBase^.actiView;
  311.     END;
  312.     MakeVPort(ADR(view^.view),ADR(view^.viewPort));
  313.     MrgCop(ADR(view^.view));
  314.     LoadView(ADR(view^.view));
  315.   END;
  316. END SetView;
  317.  
  318.  
  319.  
  320. PROCEDURE FreeView(VAR view : ViewHandlePtr);
  321. VAR rem : NewRememberPtr;
  322.     vh  : ViewHandlePtr;
  323.     t   : INTEGER;
  324. BEGIN
  325.   IF view#NIL THEN
  326.     rem:=rememberView;
  327.     WHILE rem#NIL DO
  328.       vh:=GetAddress(rem);
  329.       IF (vh#view) AND (vh#NIL) THEN
  330.         IF vh^.oldView=ADR(view^.view) THEN
  331.           vh^.oldView:=view^.oldView;
  332.         END;
  333.       END;
  334.       rem:=rem^.next;
  335.     END;
  336.     IF view^.oldView#NIL THEN
  337.       LoadView(view^.oldView);
  338.       WaitTOF;
  339.       FreeVPortCopLists(ADR(view^.viewPort));
  340.       IF view^.view.lofCprList#NIL THEN
  341.         FreeCprList(view^.view.lofCprList);
  342.       END;
  343.       IF view^.view.shfCprList#NIL THEN
  344.         FreeCprList(view^.view.shfCprList);
  345.       END;
  346.     END;
  347.     IF view^.colorMap.colorTable#NIL THEN
  348.       CutRememberStructure(rememberData,view^.colorMap.colorTable,TRUE);
  349.     END;
  350.     FOR t:=0 TO 7 DO
  351.       IF view^.bitMap.planes[t]#NIL THEN
  352.         CutRememberStructure(rememberData,view^.bitMap.planes[t],TRUE);
  353.       END;
  354.     END;
  355.     CutRememberStructure(rememberView,view,TRUE);
  356.     view:=NIL;
  357.   END;
  358. END FreeView;
  359.  
  360.  
  361. VAR rememberRaster : NewRememberPtr;
  362.  
  363. PROCEDURE CreateTmpRas(rp : RastPortPtr) : RasterPtr;
  364. VAR tr : RasterPtr;
  365.     hd : ADDRESS;
  366. BEGIN
  367.   IF rp#NIL THEN
  368.     tr:=NewAllocRemember(rememberRaster,SIZE(Raster),FALSE);
  369.     IF tr#NIL THEN
  370.       WITH rp^.bitMap^ DO
  371.         hd:=AllocRaster(bytesPerRow*8,rows);
  372.         IF hd#NIL THEN
  373.           tr^.rp:=rp;
  374.           tr^.mem:=hd;
  375.           tr^.w:=bytesPerRow*8; tr^.h:=rows;
  376.           InitTmpRas(tr^.tmpRas,hd,bytesPerRow*rows);
  377.           tr^.former:=rp^.tmpRas;
  378.           rp^.tmpRas:=ADR(tr^.tmpRas);
  379.         ELSE
  380.           CutRememberStructure(rememberRaster,tr,TRUE);
  381.           tr:=NIL;
  382.         END;
  383.       END;
  384.     END;
  385.   END;
  386.   RETURN tr;
  387. END CreateTmpRas;
  388.  
  389.  
  390. PROCEDURE FreeTmpRas(VAR rast : RasterPtr);
  391. VAR rem : NewRememberPtr;
  392.     rr  : RasterPtr;
  393.     b   : BOOLEAN;
  394. BEGIN
  395.   IF rast#NIL THEN
  396.     WITH rast^ DO
  397.       IF mem#NIL THEN
  398.         FreeRaster(mem,w,h);
  399.       END;
  400.     END;
  401.     b:=TRUE;
  402.     rem:=rememberRaster;
  403.     WHILE rem#NIL DO
  404.       rr:=GetAddress(rem);
  405.       IF rr#rast THEN
  406.         IF rr^.former=ADR(rast^.tmpRas) THEN
  407.           rr^.former:=rast^.former;
  408.           b:=FALSE;
  409.         END;
  410.       END;
  411.       rem:=rem^.next;
  412.     END;
  413.     IF b THEN
  414.       rast^.rp^.tmpRas:=rast^.former;
  415.     END;
  416.     CutRememberStructure(rememberRaster,rast,TRUE);
  417.     rast:=NIL;
  418.   END;
  419. END FreeTmpRas;
  420.  
  421.  
  422.  
  423. PROCEDURE GetPattern(pattern : ADDRESS;
  424.                      nrbp    : INTEGER;
  425.                      wh      : INTEGER) : ADDRESS;
  426. VAR mem     : ADDRESS;
  427.     c       : POINTER TO ARRAY[0..7] OF SHORTSET;
  428.     d       : POINTER TO SHORTSET;
  429.     t,x,y,i : INTEGER;
  430. BEGIN
  431.   IF (pattern#NIL) AND (wh>0) AND (nrbp>0) AND (nrbp<=6) THEN
  432.     mem:=CopyToChip(pattern,(2*wh*nrbp));
  433.     IF mem#NIL THEN
  434.       d:=mem;
  435.       FOR t:=0 TO nrbp-1 DO
  436.         c:=pattern;
  437.         FOR y:=0 TO wh-1 DO
  438.           FOR x:=0 TO 1 DO
  439.             d^:=SHORTSET{};
  440.             FOR i:=0 TO 7 DO
  441.               IF t IN c^[i] THEN
  442.                 INCL(d^,7-i);
  443.               END;
  444.             END;
  445.             INC(d);
  446.             INC(c,8);
  447.           END;
  448.         END;
  449.       END;
  450.     END;
  451.   END;
  452.   RETURN mem;
  453. END GetPattern;
  454.  
  455.  
  456.  
  457. PROCEDURE FreePattern(VAR newpattern : ADDRESS);
  458. BEGIN
  459.   FreeChipData(newpattern);
  460. END FreePattern;
  461.  
  462.  
  463.  
  464. PROCEDURE SSetRGB4(vp  : ViewPortPtr;
  465.                    nr  : CARDINAL;
  466.                    col : CARDINAL);
  467. BEGIN
  468.   IF vp#NIL THEN
  469.     SetRGB4(vp, nr, (col DIV 256) MOD 16, (col DIV 16) MOD 16, col MOD 16);
  470.   END;
  471. END SSetRGB4;
  472.  
  473.  
  474.  
  475. PROCEDURE GetPos(rp      : RastPortPtr;
  476.                  VAR x,y : INTEGER);
  477. BEGIN
  478.   IF rp#NIL THEN
  479.     x:=rp^.x; y:=rp^.y;
  480.   END;
  481. END GetPos;
  482.  
  483.  
  484.  
  485. PROCEDURE WriteText(rp  : RastPortPtr;
  486.                     x,y : INTEGER;
  487.                     col : INTEGER;
  488.                     txt : ARRAY OF CHAR);
  489. BEGIN
  490.   IF rp#NIL THEN
  491.     Move(rp,x,y);
  492.     SetAPen(rp,col);
  493.     Text(rp,ADR(txt),Length(txt));
  494.   END;
  495. END WriteText;
  496.  
  497.  
  498.  
  499. PROCEDURE Line(rp           : RastPortPtr;
  500.                x1,y1, x2,y2 : INTEGER;
  501.                col          : INTEGER);
  502. BEGIN
  503.   IF rp#NIL THEN
  504.     SetAPen(rp,col); Move(rp,x1,y1);
  505.     Draw(rp,x2,y2);
  506.   END;
  507. END Line;
  508.  
  509.  
  510.  
  511. PROCEDURE Spline(rp                      : RastPortPtr;
  512.                  x0,y0,x1,y1,x2,y2,x3,y3 : INTEGER;
  513.                  s                       : INTEGER);
  514. VAR x,y   : ARRAY[0..3] OF ARRAY[0..3] OF FFP;
  515.     m     : FFP;
  516.     c     : INTEGER;
  517.     t,u   : INTEGER;
  518.     ox,oy : INTEGER;
  519. BEGIN
  520.   Move(rp,x0,y0);
  521.   x[0,0]:=FFP(x0);
  522.   x[1,0]:=FFP(x1);
  523.   x[2,0]:=FFP(x2);
  524.   x[3,0]:=FFP(x3);
  525.   y[0,0]:=FFP(y0);
  526.   y[1,0]:=FFP(y1);
  527.   y[2,0]:=FFP(y2);
  528.   y[3,0]:=FFP(y3);
  529.   c:=0;
  530.   FOR c:=1 TO s DO
  531.     m:=FFP(c)/FFP(s);
  532.     FOR t:=1 TO 3 DO
  533.       FOR u:=0 TO 3-t DO
  534.         x[u,t]:=x[u,t-1]+m*(x[u+1,t-1]-x[u,t-1]);
  535.         y[u,t]:=y[u,t-1]+m*(y[u+1,t-1]-y[u,t-1]);
  536.       END;
  537.     END;
  538.     ox:=TRUNC(x[0,3]);
  539.     oy:=TRUNC(y[0,3]);
  540.     Draw(rp,ox,oy);
  541.   END;
  542. END Spline;
  543.  
  544.  
  545.  
  546. PROCEDURE Rect(rp           : RastPortPtr;
  547.                x1,y1, x2,y2 : INTEGER;
  548.                col          : INTEGER);
  549. BEGIN
  550.   IF rp#NIL THEN
  551.     SetAPen(rp,col); Move(rp,x1,y1); Draw(rp,x1,y2);
  552.     Draw(rp,x2,y2); Draw(rp,x2,y1); Draw(rp,x1,y1);
  553.   END;
  554. END Rect;
  555.  
  556.  
  557.  
  558. PROCEDURE InitSArea(rp  : RastPortPtr;
  559.                     max : INTEGER) : SAreaHandlePtr;
  560. VAR ai : SAreaHandlePtr;
  561. BEGIN
  562.   ai:=NewAllocRemember(rememberData,SIZE(SAreaHandle),FALSE);
  563.   IF ai#NIL THEN
  564.     ai^.rp:=rp;
  565.     ai^.mem:=NewAllocRemember(rememberData,(max+1)*5,FALSE);
  566.     IF ai^.mem#NIL THEN
  567.       ai^.max:=max;
  568.       InitArea(ai^.areaInfo,ai^.mem,max);
  569.       ai^.oAreaInfo:=rp^.areaInfo;
  570.       rp^.areaInfo:=ADR(ai^.areaInfo);
  571.     ELSE
  572.       CutRememberStructure(rememberData,ai,TRUE);
  573.     END;
  574.   END;
  575.   RETURN ai;
  576. END InitSArea;
  577.  
  578.  
  579. PROCEDURE SAreaMove(ai  : SAreaHandlePtr;
  580.                     x,y : INTEGER);
  581. BEGIN
  582.   IF ai#NIL THEN
  583.     ai^.rp^.areaInfo:=ADR(ai^.areaInfo);
  584.     IF AreaMove(ai^.rp,x,y) THEN END;
  585.   END;
  586. END SAreaMove;
  587.  
  588.  
  589. PROCEDURE SAreaDraw(ai  : SAreaHandlePtr;
  590.                     x,y : INTEGER);
  591. BEGIN
  592.   IF ai#NIL THEN
  593.     ai^.rp^.areaInfo:=ADR(ai^.areaInfo);
  594.     IF AreaDraw(ai^.rp,x,y) THEN END;
  595.   END;
  596. END SAreaDraw;
  597.  
  598.  
  599. PROCEDURE SAreaEllipse(ai  : SAreaHandlePtr;
  600.                        x,y : INTEGER;
  601.                        a,b : INTEGER);
  602. BEGIN
  603.   IF ai#NIL THEN
  604.     ai^.rp^.areaInfo:=ADR(ai^.areaInfo);
  605.     IF AreaEllipse(ai^.rp,x,y,a,b) THEN END;
  606.   END;
  607. END SAreaEllipse;
  608.  
  609.  
  610. PROCEDURE SAreaCircle(ai  : SAreaHandlePtr;
  611.                       x,y : INTEGER;
  612.                       r   : INTEGER);
  613. BEGIN
  614.   IF ai#NIL THEN
  615.     ai^.rp^.areaInfo:=ADR(ai^.areaInfo);
  616.     IF AreaCircle(ai^.rp,x,y,r) THEN END;
  617.   END;
  618. END SAreaCircle;
  619.  
  620.  
  621. PROCEDURE SAreaEnd(VAR ai   : SAreaHandlePtr;
  622.                        type : SAreaEndFlag);
  623. VAR tr : RasterPtr;
  624. BEGIN
  625.   IF ai#NIL THEN
  626.     ai^.rp^.areaInfo:=ADR(ai^.areaInfo);
  627.     tr:=CreateTmpRas(ai^.rp);
  628.     IF tr#NIL THEN
  629.       IF type=aOutline THEN
  630.         INCL(ai^.rp^.flags,areaOutline);
  631.       ELSE
  632.         EXCL(ai^.rp^.flags,areaOutline);
  633.       END;
  634.       IF AreaEnd(ai^.rp) THEN END;
  635.       FreeTmpRas(tr);
  636.       ai^.rp^.areaInfo:=ai^.oAreaInfo;
  637.     END;
  638.     CutRememberStructure(rememberData,ai^.mem,TRUE);
  639.     CutRememberStructure(rememberData,ai,TRUE);
  640.     ai:=NIL;
  641.   END;
  642. END SAreaEnd;
  643.  
  644.  
  645. PROCEDURE Fill(rp  : RastPortPtr;
  646.                fm  : FillMode;
  647.                x,y : INTEGER;
  648.                oc  : INTEGER);
  649. VAR tr : RasterPtr;
  650. BEGIN
  651.   IF rp#NIL THEN
  652.     tr:=CreateTmpRas(rp);
  653.     IF tr#NIL THEN
  654.       IF fm=fOutline THEN
  655.         SetOPen(rp,oc);
  656.         IF Flood(rp,0,x,y) THEN END;
  657.       ELSE
  658.         IF Flood(rp,1,x,y) THEN END;
  659.       END;
  660.       FreeTmpRas(tr);
  661.     END;
  662.   END;
  663. END Fill;
  664.  
  665.  
  666.  
  667. VAR rememberSprite : NewRememberPtr;
  668.  
  669. PROCEDURE GetPair(a,b : SimpleSpritePtr;
  670.                   nr  : CARDINAL) : BOOLEAN;
  671. VAR return : BOOLEAN;
  672. BEGIN
  673.   return:=FALSE;
  674.   IF GetSprite(a,nr)#-1 THEN
  675.     IF GetSprite(b,nr-2*(nr MOD 2)+1)=-1 THEN
  676.       FreeSprite(nr);
  677.     ELSE
  678.       return:=TRUE;
  679.     END;
  680.   END;
  681.   RETURN return;
  682. END GetPair;
  683.  
  684.  
  685.  
  686. PROCEDURE SnapSprite(nr     : INTEGER;
  687.                      rp     : RastPortPtr;
  688.                      x,y    : CARDINAL;
  689.                      h      : CARDINAL;
  690.                      dx,dy  : CARDINAL;
  691.                      attach : BOOLEAN) : SpriteHandlePtr;
  692.  
  693.     PROCEDURE AllocData(VAR ss : SimpleSprite;
  694.                         dx,dy  : CARDINAL;
  695.                         h      : CARDINAL);
  696.     BEGIN
  697.       WITH ss DO
  698.         height:=h; x:=dx; y:=dy;
  699.         posctldata:=NewAllocRemember(rememberData,4*(h+2),TRUE);
  700.       END;
  701.     END AllocData;
  702.  
  703. VAR ss      : SpriteHandlePtr;
  704.     bitmap  : BitMap;
  705.     dca,dcb : POINTER TO ARRAY[0..255] OF CARDINAL;
  706.     zp      : ADDRESS;
  707.     lc      : LONGCARD;
  708. BEGIN
  709.   ss:=NIL;
  710.   IF (h>0) AND (nr>=0) AND (nr<=7) THEN
  711.     ss:=NewAllocRemember(rememberSprite,SIZE(SpriteHandle),FALSE);
  712.     IF ss#NIL THEN
  713.       WITH ss^ DO
  714.         AllocData(sprite,dx,dy,h);
  715.         IF sprite.posctldata#NIL THEN
  716.           IF attach THEN
  717.             AllocData(attached,dx,dy,h);
  718.             is:=TRUE;
  719.           END;
  720.           IF (NOT attach) OR (attached.posctldata#NIL) THEN
  721.             dca:=sprite.posctldata;
  722.             dcb:=attached.posctldata;
  723.             IF (sprite.num>attached.num) AND attach THEN
  724.               zp:=dca; dca:=dcb; dcb:=zp;
  725.             END;
  726.             IF attach THEN
  727.               dca^[1]:=spriteAttached;
  728.               dcb^[1]:=spriteAttached;
  729.             END;
  730.  
  731.             IF rp#NIL THEN
  732.               WITH bitmap DO
  733.                 bytesPerRow:=4; rows:=h;
  734.                 depth:=2; IF attach THEN depth:=4; END;
  735.                 flags:=0;
  736.                 planes[0]:=dca; INC(planes[0],4);
  737.                 planes[1]:=dca; INC(planes[1],6);
  738.                 IF attach THEN
  739.                   planes[2]:=dcb; INC(planes[2],4);
  740.                   planes[3]:=dcb; INC(planes[3],6);
  741.                 END;
  742.               END;
  743.               lc:=BltBitMap(rp^.bitMap,x,y,ADR(bitmap),0,0,16,h,192,15,NIL);
  744.             END;
  745.             IF attach THEN
  746.               IF NOT GetPair(ADR(sprite),ADR(attached),nr) THEN
  747.                 nr:=0;
  748.                 WHILE (NOT GetPair(ADR(sprite),ADR(attached),nr)) AND (nr<8) DO
  749.                   INC(nr,2);
  750.                 END;
  751.                 IF nr>7 THEN
  752.                   sprite.num:=-1;
  753.                   attached.num:=-1;
  754.                 END;
  755.               END;
  756.             ELSE
  757.               IF GetSprite(ADR(sprite),nr)=-1 THEN
  758.                 IF GetSprite(ADR(sprite),nr-2*(nr MOD 2)+1)=-1 THEN
  759.                   sprite.num:=GetSprite(ADR(sprite),-1);
  760.                 END;
  761.               END;
  762.             END;
  763.           ELSE
  764.             CutRememberStructure(rememberData,sprite.posctldata,TRUE);
  765.             CutRememberStructure(rememberSprite,ss,TRUE);
  766.           END;
  767.         ELSE
  768.           CutRememberStructure(rememberSprite,ss,TRUE);
  769.         END;
  770.       END;
  771.     END;
  772.   END;
  773.   RETURN ss;
  774. END SnapSprite;
  775.  
  776.  
  777.  
  778. PROCEDURE EraseSprite(sh : SpriteHandlePtr);
  779. BEGIN
  780.   IF sh#NIL THEN
  781.     WITH sh^ DO
  782.       IF sprite.num>=0 THEN
  783.         FreeSprite(sprite.num);
  784.         sprite.num:=-1;
  785.       END;
  786.       IF is THEN
  787.         IF attached.num>=0 THEN
  788.           FreeSprite(attached.num);
  789.           attached.num:=-1;
  790.         END;
  791.       END;
  792.     END;
  793.   END;
  794. END EraseSprite;
  795.  
  796.  
  797.  
  798. PROCEDURE ResetSprite(sh : SpriteHandlePtr;
  799.                       nr : INTEGER) : INTEGER;
  800. BEGIN
  801.   IF sh#NIL THEN
  802.     WITH sh^ DO
  803.       IF is THEN
  804.         IF NOT GetPair(ADR(sprite),ADR(attached),nr) THEN
  805.           nr:=0;
  806.           WHILE (NOT GetPair(ADR(sprite),ADR(attached),nr)) AND (nr<8) DO
  807.             INC(nr,2);
  808.           END;
  809.           IF nr>7 THEN
  810.             sprite.num:=-1;
  811.             attached.num:=-1;
  812.           END;
  813.         END;
  814.       ELSE
  815.         IF GetSprite(ADR(sprite),nr)=-1 THEN
  816.           IF GetSprite(ADR(sprite),nr-2*(nr MOD 2)+1)=-1 THEN
  817.             sprite.num:=GetSprite(ADR(sprite),-1);
  818.           END;
  819.         END;
  820.       END;
  821.     END;
  822.     RETURN sh^.sprite.num;
  823.   ELSE
  824.     RETURN -2;
  825.   END;
  826. END ResetSprite;
  827.  
  828.  
  829.  
  830. PROCEDURE RemSprite(VAR sh : SpriteHandlePtr);
  831. BEGIN
  832.   IF sh#NIL THEN
  833.     EraseSprite(sh);
  834.     IF sh^.sprite.posctldata#NIL THEN
  835.       CutRememberStructure(rememberData,sh^.sprite.posctldata,TRUE);
  836.     END;
  837.     IF sh^.attached.posctldata#NIL THEN
  838.       CutRememberStructure(rememberData,sh^.attached.posctldata,TRUE);
  839.     END;
  840.     CutRememberStructure(rememberSprite,sh,TRUE);
  841.     sh:=NIL;
  842.   END;
  843. END RemSprite;
  844.  
  845.  
  846.  
  847. PROCEDURE SaveSprite(VAR fh : File;
  848.                          sh : SpriteHandlePtr);
  849. VAR li : LONGINT;
  850. BEGIN
  851.   IF (fh.file#NIL) AND (sh#NIL) THEN
  852.     WriteBytes(fh,sh,SIZE(SpriteHandle),li);
  853.     WITH sh^.sprite DO
  854.       IF posctldata#NIL THEN
  855.         WriteBytes(fh,posctldata,4*(height+2),li);
  856.       END;
  857.     END;
  858.     WITH sh^.attached DO
  859.       IF (posctldata#NIL) AND (sh^.is) THEN
  860.         WriteBytes(fh,posctldata,4*(height+2),li);
  861.       END;
  862.     END;
  863.   END;
  864. END SaveSprite;
  865.  
  866.  
  867.  
  868. PROCEDURE LoadSprite(VAR fh    : File;
  869.                          nr    : INTEGER;
  870.                          dx,dy : CARDINAL) : SpriteHandlePtr;
  871. VAR sh : SpriteHandlePtr;
  872.     li : LONGINT;
  873. BEGIN
  874.   sh:=NIL;
  875.   IF (fh.file#NIL) THEN
  876.     sh:=NewAllocRemember(rememberSprite,SIZE(SpriteHandle),FALSE);
  877.     IF sh#NIL THEN
  878.       ReadBytes(fh,sh,SIZE(SpriteHandle),li);
  879.       WITH sh^ DO
  880.         IF sprite.posctldata#NIL THEN
  881.           WITH sprite DO
  882.             posctldata:=NewAllocRemember(rememberData,4*(height+2),TRUE);
  883.             IF posctldata#NIL THEN
  884.               ReadBytes(fh,posctldata,4*(height+2),li);
  885.             END;
  886.           END;
  887.         END;
  888.         IF (attached.posctldata#NIL) AND (sh^.is) THEN
  889.           WITH attached DO
  890.             posctldata:=NewAllocRemember(rememberData,4*(height+2),TRUE);
  891.             IF posctldata#NIL THEN
  892.               ReadBytes(fh,posctldata,4*(height+2),li);
  893.             END;
  894.           END;
  895.         END;
  896.         sprite.num:=-1;
  897.         attached.num:=-1;
  898.         sprite.x:=dx; sprite.y:=dy;
  899.         attached.x:=dx; attached.y:=dy;
  900.         IF ResetSprite(sh,nr)=0 THEN END;
  901.       END;
  902.     END;
  903.   END;
  904.   RETURN sh;
  905. END LoadSprite;
  906.  
  907.  
  908.  
  909. PROCEDURE SetSpriteColors(sh : SpriteHandlePtr;
  910.                           vp : ViewPortPtr;
  911.                           c  : ARRAY OF CARDINAL);
  912. VAR nr,max,t : INTEGER;
  913. BEGIN
  914.   IF (sh#NIL) AND (vp#NIL) THEN
  915.     nr:=sh^.sprite.num;
  916.     IF nr>=0 THEN
  917.       nr:=nr DIV 2;
  918.       nr:=nr*4+16;
  919.       max:=3;
  920.       IF sh^.is THEN
  921.         max:=15; nr:=16;
  922.       END;
  923.       FOR t:=0 TO max DO
  924.         IF t<=HIGH(c) THEN
  925.           SetRGB4(vp,nr+t,(c[t] DIV 256) MOD 16,
  926.                   (c[t] DIV 16) MOD 16,c[t] MOD 16);
  927.         END;
  928.       END;
  929.     END;
  930.   END;
  931. END SetSpriteColors;
  932.  
  933.  
  934. VAR maxTest : INTEGER;
  935.  
  936. PROCEDURE SetSpriteCollision(planes   : SHORTSET;
  937.                              bits     : SHORTSET;
  938.                              sprites  : SHORTSET;
  939.                              maxTests : INTEGER);
  940. VAR collision : CollisionControlFlagSet;
  941. BEGIN
  942.   maxTest:=maxTests;
  943.   collision:=CollisionControlFlagSet{};
  944.   IF 0 IN planes THEN INCL(collision,enablePlane1); END;
  945.   IF 1 IN planes THEN INCL(collision,enablePlane2); END;
  946.   IF 2 IN planes THEN INCL(collision,enablePlane3); END;
  947.   IF 3 IN planes THEN INCL(collision,enablePlane4); END;
  948.   IF 4 IN planes THEN INCL(collision,enablePlane5); END;
  949.   IF 5 IN planes THEN INCL(collision,enablePlane6); END;
  950.  
  951.   IF 0 IN bits THEN INCL(collision,plane1); END;
  952.   IF 1 IN bits THEN INCL(collision,plane2); END;
  953.   IF 2 IN bits THEN INCL(collision,plane3); END;
  954.   IF 3 IN bits THEN INCL(collision,plane4); END;
  955.   IF 4 IN bits THEN INCL(collision,plane5); END;
  956.   IF 5 IN bits THEN INCL(collision,plane6); END;
  957.  
  958.   IF 1 IN sprites THEN INCL(collision,enableSprite01); END;
  959.   IF 3 IN sprites THEN INCL(collision,enableSprite23); END;
  960.   IF 5 IN sprites THEN INCL(collision,enableSprite45); END;
  961.   IF 7 IN sprites THEN INCL(collision,enableSprite67); END;
  962.   custom.clxcon:=collision;
  963. END SetSpriteCollision;
  964.  
  965.  
  966.  
  967. PROCEDURE GetSpriteCollision(sh : SpriteHandlePtr) : SpriteCollisionSet;
  968. VAR set    : POINTER TO BITSET;
  969.     return : SpriteCollisionSet;
  970.     nr,t   : INTEGER;
  971. BEGIN
  972.   return:=SpriteCollisionSet{};
  973.   IF sh#NIL THEN
  974.     set:=ADR(custom.clxdat);
  975.     nr:=sh^.sprite.num;
  976.     nr:=((nr-(nr MOD 2)) DIV 2) MOD 4;
  977.     FOR t:=0 TO maxTest DO
  978.       IF (nr+1) IN set^ THEN
  979.         INCL(return,oddPlane);
  980.       END;
  981.       IF (nr+5) IN set^ THEN
  982.         INCL(return,evenPlane);
  983.       END;
  984.       CASE nr OF
  985.       |0 : IF 9  IN set^ THEN INCL(return,sprite2or3); END;
  986.            IF 10 IN set^ THEN INCL(return,sprite4or5); END;
  987.            IF 11 IN set^ THEN INCL(return,sprite6or7); END;
  988.       |1 : IF 12 IN set^ THEN INCL(return,sprite4or5); END;
  989.            IF 13 IN set^ THEN INCL(return,sprite6or7); END;
  990.       |2 : IF 14 IN set^ THEN INCL(return,sprite6or7); END;
  991.       ELSE
  992.       END;
  993.     END;
  994.   END;
  995.   RETURN return;
  996. END GetSpriteCollision;
  997.  
  998.  
  999.  
  1000. PROCEDURE NewSpriteGraphics(sh   : SpriteHandlePtr;
  1001.                             vp   : ViewPortPtr;
  1002.                             data : ADDRESS);
  1003. BEGIN
  1004.   IF (sh#NIL) AND (vp#NIL) AND (data#NIL) THEN
  1005.     WITH sh^ DO
  1006.       ChangeSprite(vp,ADR(sprite),data);
  1007.       IF is THEN
  1008.         INC(data,sprite.height*4);
  1009.         ChangeSprite(vp,ADR(attached),data);
  1010.       END;
  1011.     END;
  1012.   END;
  1013. END NewSpriteGraphics;
  1014.  
  1015.  
  1016.  
  1017. PROCEDURE MoveSpriteTo(sh  : SpriteHandlePtr;
  1018.                        vp  : ViewPortPtr;
  1019.                        x,y : INTEGER);
  1020. BEGIN
  1021.   IF (sh#NIL) AND (vp#NIL) THEN
  1022.     WITH sh^ DO
  1023.       MoveSprite(vp,ADR(sprite),x,y);
  1024.       IF is THEN
  1025.         MoveSprite(vp,ADR(attached),x,y);
  1026.       END;
  1027.     END;
  1028.   END;
  1029. END MoveSpriteTo;
  1030.  
  1031.  
  1032.  
  1033. VAR rememberVSprite : NewRememberPtr;
  1034.  
  1035. PROCEDURE MoveVSprite(vsp : VSpritePtr;
  1036.                       x,y : INTEGER);
  1037. BEGIN
  1038.   IF vsp#NIL THEN
  1039.     vsp^.x:=x;
  1040.     vsp^.y:=y;
  1041.   END;
  1042. END MoveVSprite;
  1043.  
  1044.  
  1045.  
  1046. PROCEDURE MoveBob(bob : BobPtr;
  1047.                   x,y : INTEGER);
  1048. BEGIN
  1049.   IF bob#NIL THEN
  1050.     MoveVSprite(bob^.bobVSprite,x,y);
  1051.   END;
  1052. END MoveBob;
  1053.  
  1054.  
  1055.  
  1056. PROCEDURE RedrawGels(rp   : RastPortPtr;
  1057.                      vp   : ViewPortPtr;
  1058.                      view : ViewPtr;
  1059.                      wait : RedrawWaitMode);
  1060. BEGIN
  1061.   IF (rp#NIL) AND (vp#NIL) THEN
  1062.     SortGList(rp);
  1063.     DrawGList(rp,vp);
  1064.     IF view#NIL THEN
  1065.       MakeVPort(view,vp);
  1066.       MrgCop(view);
  1067.       IF wait=waitTOF THEN WaitTOF;
  1068.       ELSIF (wait=waitBOVP) AND (vp#NIL) THEN WaitBOVP(vp);
  1069.       END;
  1070.       LoadView(view);
  1071.     ELSE
  1072.       IF wait=waitTOF THEN WaitTOF;
  1073.       ELSIF (wait=waitBOVP) AND (vp#NIL) THEN WaitBOVP(vp);
  1074.       END;
  1075.       RemakeDisplay;
  1076.     END;
  1077.   END;
  1078. END RedrawGels;
  1079.  
  1080.  
  1081.  
  1082. PROCEDURE DeallocateGel(vsp : VSpritePtr);
  1083. BEGIN
  1084.   IF vsp#NIL THEN
  1085.     WITH vsp^ DO
  1086.       IF vsBob#NIL THEN
  1087.         IF vsBob^.dBuffer#NIL THEN
  1088.           CutRememberStructure(rememberData,vsBob^.dBuffer^.bufBuffer,TRUE);
  1089.           CutRememberStructure(rememberData,vsBob^.dBuffer,TRUE);
  1090.         END;
  1091.         CutRememberStructure(rememberData,vsBob^.saveBuffer,TRUE);
  1092.         CutRememberStructure(rememberData,vsBob,TRUE);
  1093.       END;
  1094.       CutRememberStructure(rememberData,imageData,TRUE);
  1095.       CutRememberStructure(rememberData,collMask,TRUE);
  1096.       CutRememberStructure(rememberData,borderLine,TRUE);
  1097.     END;
  1098.     CutRememberStructure(rememberVSprite,vsp,TRUE);
  1099.   END;
  1100. END DeallocateGel;
  1101.  
  1102.  
  1103.  
  1104. PROCEDURE SaveVSprite(VAR fh  : File;
  1105.                           vsp : VSpritePtr);
  1106. VAR li : LONGINT;
  1107. BEGIN
  1108.   IF (vsp#NIL) AND (fh.file#NIL) THEN
  1109.     WriteBytes(fh,vsp,SIZE(VSprite),li);
  1110.     WITH vsp^ DO
  1111.       IF vsBob#NIL THEN
  1112.         WriteBytes(fh,vsBob,SIZE(Bob),li);
  1113.       END;
  1114.       IF imageData#NIL THEN
  1115.         WriteBytes(fh,imageData,width*2*height*depth,li);
  1116.       END;
  1117.       IF collMask#NIL THEN
  1118.         WriteBytes(fh,collMask,width*2*height,li);
  1119.       END;
  1120.       IF borderLine#NIL THEN
  1121.         WriteBytes(fh,borderLine,width*2,li);
  1122.       END;
  1123.     END;
  1124.   END;
  1125. END SaveVSprite;
  1126.  
  1127.  
  1128.  
  1129. PROCEDURE LoadVSprite(VAR fh : File;
  1130.                           rp : RastPortPtr) : VSpritePtr;
  1131. VAR li  : LONGINT;
  1132.     vsp : VSpritePtr;
  1133.     get : ADDRESS;
  1134. BEGIN
  1135.   IF fh.file#NIL THEN
  1136.     vsp:=NewAllocRemember(rememberVSprite,SIZE(VSprite),FALSE);
  1137.     IF vsp#NIL THEN
  1138.       ReadBytes(fh,vsp,SIZE(VSprite),li);
  1139.       IF vsp^.vsBob#NIL THEN
  1140.         vsp^.vsBob:=NewAllocRemember(rememberData,SIZE(Bob),FALSE);
  1141.         IF vsp^.vsBob#NIL THEN
  1142.           ReadBytes(fh,vsp^.vsBob,SIZE(Bob),li);
  1143.           WITH vsp^.vsBob^ DO
  1144.             IF saveBuffer#NIL THEN
  1145.               saveBuffer:=NewAllocRemember(rememberData,
  1146.                           vsp^.width*2*vsp^.height*(vsp^.depth+1),TRUE);
  1147.               IF saveBuffer#NIL THEN
  1148.                 IF dBuffer#NIL THEN
  1149.                   get:=dBuffer^.bufBuffer;
  1150.                   dBuffer:=NewAllocRemember(rememberData,SIZE(DBufPacket),
  1151.                            FALSE);
  1152.                   IF dBuffer#NIL THEN
  1153.                     IF get#NIL THEN
  1154.                       dBuffer^.bufBuffer:=NewAllocRemember(rememberData,
  1155.                                vsp^.width*2*vsp^.height*(vsp^.depth+1),TRUE);
  1156.                       IF dBuffer^.bufBuffer=NIL THEN
  1157.                         DeallocateGel(vsp);
  1158.                       END;
  1159.                     END;
  1160.                   ELSE
  1161.                     DeallocateGel(vsp);
  1162.                   END;
  1163.                 END;
  1164.               ELSE
  1165.                 DeallocateGel(vsp);
  1166.               END;
  1167.             END;
  1168.           END;
  1169.         ELSE
  1170.           DeallocateGel(vsp);
  1171.         END;
  1172.       END;
  1173.  
  1174.       IF vsp#NIL THEN
  1175.         IF vsp^.imageData#NIL THEN
  1176.           vsp^.imageData:=NewAllocRemember(rememberData,
  1177.                           vsp^.width*2*vsp^.height*vsp^.depth,TRUE);
  1178.           IF vsp^.imageData#NIL THEN
  1179.             ReadBytes(fh,vsp^.imageData,vsp^.width*2*vsp^.height*vsp^.depth,li);
  1180.           ELSE
  1181.             DeallocateGel(vsp);
  1182.           END;
  1183.         END;
  1184.       END;
  1185.  
  1186.       IF vsp#NIL THEN
  1187.         IF vsp^.collMask#NIL THEN
  1188.           vsp^.collMask:=NewAllocRemember(rememberData,
  1189.                          vsp^.width*2*vsp^.height,TRUE);
  1190.           IF vsp^.collMask#NIL THEN
  1191.             ReadBytes(fh,vsp^.collMask,vsp^.width*2*vsp^.height,li);
  1192.           ELSE
  1193.             DeallocateGel(vsp);
  1194.           END;
  1195.         END;
  1196.       END;
  1197.  
  1198.       IF vsp#NIL THEN
  1199.         IF vsp^.borderLine#NIL THEN
  1200.           vsp^.borderLine:=NewAllocRemember(rememberData,vsp^.width*2,TRUE);
  1201.           IF vsp^.borderLine#NIL THEN
  1202.             ReadBytes(fh,vsp^.borderLine,vsp^.width*2,li);
  1203.           ELSE
  1204.             DeallocateGel(vsp);
  1205.           END;
  1206.         END;
  1207.       END;
  1208.  
  1209.       IF vsp#NIL THEN
  1210.         IF vsprite IN vsp^.flags THEN
  1211.           AddVSprite(vsp,rp);
  1212.         ELSE
  1213.           AddBob(vsp^.vsBob,rp);
  1214.         END;
  1215.       END;
  1216.     END;
  1217.   END;
  1218.   RETURN vsp;
  1219. END LoadVSprite;
  1220.  
  1221.  
  1222.  
  1223. PROCEDURE SaveBob(VAR fh  : File;
  1224.                       bob : BobPtr);
  1225. BEGIN
  1226.   IF bob#NIL THEN
  1227.     SaveVSprite(fh,bob^.bobVSprite);
  1228.   END;
  1229. END SaveBob;
  1230.  
  1231.  
  1232.  
  1233. PROCEDURE LoadBob(VAR fh : File;
  1234.                       rp : RastPortPtr) : BobPtr;
  1235. VAR vsp : VSpritePtr;
  1236. BEGIN
  1237.   vsp:=LoadVSprite(fh,rp);
  1238.   RETURN vsp^.vsBob;
  1239. END LoadBob;
  1240.  
  1241.  
  1242.  
  1243. PROCEDURE FreeGel(VAR vsp   : VSpritePtr;
  1244.                       rp    : RastPortPtr;
  1245.                       vp    : ViewPortPtr;
  1246.                       view  : ViewPtr;
  1247.                       erase : BOOLEAN);
  1248.  
  1249. VAR  bl,cm : ADDRESS;
  1250.      w,h,d : INTEGER;
  1251.      nb    : NewBobPtr;
  1252. BEGIN
  1253.   IF vsp#NIL THEN
  1254.     IF vsprite IN vsp^.flags THEN
  1255.       RemVSprite(vsp);
  1256.     ELSE
  1257.       IF vsp^.vsBob#NIL THEN
  1258.         nb:=ADDRESS(vsp^.vsBob);
  1259.         IF nb^.user=bobAdded THEN
  1260.           IF (rp#NIL) AND (vp#NIL) THEN
  1261.             RemIBob(vsp^.vsBob,rp,vp);
  1262.           ELSE
  1263.             RemBob(vsp^.vsBob);
  1264.           END;
  1265.         END;
  1266.       END;
  1267.     END;
  1268.     IF erase THEN
  1269.       RedrawGels(rp,vp,view,waitBOVP); (* Sorry *)
  1270.     END;
  1271.     DeallocateGel(vsp);
  1272.   END;
  1273.   vsp:=NIL;
  1274. END FreeGel;
  1275.  
  1276.  
  1277.  
  1278. PROCEDURE SetVSpriteImage(vs     : VSpritePtr;
  1279.                           buffer : ADDRESS;
  1280.                           owrite : BOOLEAN);
  1281. VAR copys,copyd : POINTER TO CARDINAL;
  1282.     t           : INTEGER;
  1283. BEGIN
  1284.   IF (vs#NIL) AND (buffer#NIL) THEN
  1285.     IF owrite THEN
  1286.       copys:=buffer; copyd:=vs^.imageData;
  1287.       IF copyd#NIL THEN
  1288.         FOR t:=0 TO vs^.width*vs^.height*vs^.depth-1 DO
  1289.           copyd^:=copys^;
  1290.           INC(copyd,2); INC(copys,2);
  1291.         END;
  1292.         InitMasks(vs);
  1293.       END;
  1294.     ELSE
  1295.       vs^.imageData:=buffer;
  1296.       InitMasks(vs);
  1297.     END;
  1298.   END;
  1299. END SetVSpriteImage;
  1300.  
  1301.  
  1302.  
  1303. PROCEDURE SetBobImage(bob    : BobPtr;
  1304.                       buffer : ADDRESS;
  1305.                       owrite : BOOLEAN);
  1306. BEGIN
  1307.   IF bob#NIL THEN
  1308.     IF bob^.bobVSprite#NIL THEN
  1309.       SetVSpriteImage(bob^.bobVSprite,buffer,owrite);
  1310.     END;
  1311.   END;
  1312. END SetBobImage;
  1313.  
  1314.  
  1315.  
  1316. PROCEDURE GetVSpriteImage(vs  : VSpritePtr) : ADDRESS;
  1317. VAR r : ADDRESS;
  1318. BEGIN
  1319.   r:=NIL;
  1320.   IF vs#NIL THEN
  1321.     r:=vs^.imageData;
  1322.   END;
  1323.   RETURN r;
  1324. END GetVSpriteImage;
  1325.  
  1326.  
  1327.  
  1328. PROCEDURE GetBobImage(bob  : BobPtr) : ADDRESS;
  1329. VAR r : ADDRESS;
  1330. BEGIN
  1331.   r:=NIL;
  1332.   IF bob#NIL THEN
  1333.     IF bob^.bobVSprite#NIL THEN
  1334.       r:=bob^.bobVSprite^.imageData;
  1335.     END;
  1336.   END;
  1337.   RETURN r;
  1338. END GetBobImage;
  1339.  
  1340.  
  1341.  
  1342. PROCEDURE GetGel(rp     : RastPortPtr;
  1343.                  x,y    : INTEGER;
  1344.                  w,h    : INTEGER;
  1345.                  d      : INTEGER;
  1346.                  fl     : VSpriteFlagSet;
  1347.                  bfl    : BobFlagSet;
  1348.                  hit    : BITSET;
  1349.                  me     : BITSET;
  1350.                  colors : ADDRESS;
  1351.                  drp    : RastPortPtr;
  1352.                  dx,dy  : INTEGER;
  1353.                  doub   : BOOLEAN;
  1354.                  anim   : BOOLEAN;
  1355.                  image  : BOOLEAN;
  1356.                  buffer : BobPtr) : VSpritePtr;
  1357. VAR vsp    : VSpritePtr;
  1358.     bob    : BobPtr;
  1359.     nb     : NewBobPtr;
  1360.     bitmap : BitMap;
  1361.     lc     : LONGCARD;
  1362. BEGIN
  1363.   vsp:=NewAllocRemember(rememberVSprite,SIZE(VSprite),FALSE);
  1364.   IF vsp#NIL THEN
  1365.     WITH vsp^ DO
  1366.       flags:=fl; x:=dx; y:=dy; width:=(w+15) DIV 16; height:=h; depth:=d;
  1367.       meMask:=me; hitMask:=hit; sprColors:=colors; planePick:=255;
  1368.       planeOnOff:=0;
  1369.       borderLine:=NewAllocRemember(rememberData,width*2,TRUE);
  1370.     END;
  1371.     IF vsp^.borderLine#NIL THEN
  1372.       vsp^.collMask:=NewAllocRemember(rememberData,vsp^.width*2*h,TRUE);
  1373.       IF vsp^.collMask#NIL THEN
  1374.         IF vsprite IN fl THEN d:=2; END;
  1375.         IF image THEN
  1376.           vsp^.imageData:=NewAllocRemember(rememberData,vsp^.width*2*h*d,TRUE);
  1377.         END;
  1378.         IF (vsp^.imageData#NIL) OR NOT image THEN
  1379.           IF (rp#NIL) AND image THEN
  1380.             IF vsprite IN fl THEN
  1381.               WITH bitmap DO
  1382.                 bytesPerRow:=4; rows:=h;
  1383.                 depth:=d; flags:=0;
  1384.                 planes[0]:=vsp^.imageData;
  1385.                 planes[1]:=vsp^.imageData; INC(planes[1],2);
  1386.               END;
  1387.               lc:=BltBitMap(rp^.bitMap,x,y,ADR(bitmap),0,0,16,h,192,255,NIL);
  1388.             ELSE
  1389.               WITH bitmap DO
  1390.                 bytesPerRow:=vsp^.width*2; rows:=h;
  1391.                 depth:=d; flags:=0;
  1392.                 FOR lc:=0 TO d-1 DO
  1393.                   planes[lc]:=vsp^.imageData+ADDRESS(lc)*vsp^.width*2*h;
  1394.                 END;
  1395.               END;
  1396.               lc:=BltBitMap(rp^.bitMap,x,y,ADR(bitmap),0,0,w,h,192,255,NIL);
  1397.             END;
  1398.           END;
  1399.           IF image THEN InitMasks(vsp); END;
  1400.           IF NOT (vsprite IN fl) THEN
  1401.             bob:=NewAllocRemember(rememberData,SIZE(Bob)+4,FALSE);
  1402.             IF bob#NIL THEN
  1403.               nb:=ADDRESS(bob);
  1404.               nb^.user:=notAdded;
  1405.               WITH bob^ DO
  1406.                 bobVSprite:=vsp; flags:=bfl;
  1407.                 vsp^.vsBob:=bob; imageShadow:=vsp^.collMask;
  1408.                 IF buffer=NIL THEN
  1409.                   saveBuffer:=NewAllocRemember(rememberData,vsp^.width*2*h*(d+1),
  1410.                               TRUE);
  1411.                   IF (saveBuffer#NIL) THEN
  1412.                     IF doub THEN
  1413.                       dBuffer:=NewAllocRemember(rememberData,SIZE(DBufPacket),
  1414.                                FALSE);
  1415.                       IF dBuffer#NIL THEN
  1416.                         dBuffer^.bufBuffer:=NewAllocRemember(rememberData,
  1417.                                             vsp^.width*2*h*(d+1),TRUE);
  1418.                         IF dBuffer^.bufBuffer=NIL THEN
  1419.                           DeallocateGel(vsp);
  1420.                         END;
  1421.                       ELSE
  1422.                         DeallocateGel(vsp);
  1423.                       END;
  1424.                     END;
  1425.                   ELSE
  1426.                     DeallocateGel(vsp);
  1427.                   END;
  1428.                 ELSE
  1429.                   saveBuffer:=buffer^.saveBuffer;
  1430.                   IF (buffer^.dBuffer#NIL) AND doub THEN
  1431.                     dBuffer:=NewAllocRemember(rememberData,SIZE(DBufPacket),
  1432.                              FALSE);
  1433.                     IF dBuffer#NIL THEN
  1434.                       dBuffer^.bufBuffer:=buffer^.dBuffer^.bufBuffer;
  1435.                     END;
  1436.                   ELSE
  1437.                     dBuffer:=NIL;
  1438.                   END;
  1439.  
  1440.                 END;
  1441.               END;
  1442.             ELSE
  1443.               DeallocateGel(vsp);
  1444.             END;
  1445.           END;
  1446.           IF vsprite IN fl THEN
  1447.             AddVSprite(vsp,drp);
  1448.           ELSE
  1449.             IF NOT anim THEN
  1450.               AddBob(bob,drp);
  1451.               IF nb#NIL THEN
  1452.                 nb^.user:=bobAdded;
  1453.               END;
  1454.             END;
  1455.           END;
  1456.         ELSE
  1457.           DeallocateGel(vsp);
  1458.         END;
  1459.       ELSE
  1460.         DeallocateGel(vsp);
  1461.       END;
  1462.     ELSE
  1463.       DeallocateGel(vsp);
  1464.     END;
  1465.   END;
  1466.   RETURN vsp;
  1467. END GetGel;
  1468.  
  1469.  
  1470.  
  1471. PROCEDURE GetVSprite(rp     : RastPortPtr;
  1472.                      x,y    : INTEGER;
  1473.                      h      : INTEGER;
  1474.                      must   : BOOLEAN;
  1475.                      image  : BOOLEAN;
  1476.                      hit    : BITSET;
  1477.                      me     : BITSET;
  1478.                      colors : ADDRESS;
  1479.                      drp    : RastPortPtr;
  1480.                      dx,dy  : INTEGER) : VSpritePtr;
  1481.  
  1482. VAR fl : VSpriteFlagSet;
  1483.  
  1484. BEGIN
  1485.   fl:=VSpriteFlagSet{vsprite};
  1486.   IF must THEN INCL(fl,mustDraw); END;
  1487.   RETURN GetGel(rp,x,y,16,h,2,fl,BobFlagSet{},hit,me,colors,drp,dx,dy,FALSE,FALSE,image,NIL);
  1488. END GetVSprite;
  1489.  
  1490.  
  1491.  
  1492. PROCEDURE FreeVSprite(VAR vsp   : VSpritePtr;
  1493.                           rp    : RastPortPtr;
  1494.                           vp    : ViewPortPtr;
  1495.                           view  : ViewPtr;
  1496.                           erase : BOOLEAN);
  1497.  
  1498. BEGIN
  1499.   FreeGel(vsp,rp,vp,view,erase);
  1500. END FreeVSprite;
  1501.  
  1502.  
  1503.  
  1504. PROCEDURE GetBob(rp     : RastPortPtr;
  1505.                  x,y    : INTEGER;
  1506.                  w,h    : INTEGER;
  1507.                  d      : INTEGER;
  1508.                  flags  : BobTypeFlagSet;
  1509.                  hit    : BITSET;
  1510.                  me     : BITSET;
  1511.                  buffer : BobPtr;
  1512.                  drp    : RastPortPtr;
  1513.                  dx,dy  : INTEGER) : BobPtr;
  1514.  
  1515. VAR vsp : VSpritePtr;
  1516.     fl  : VSpriteFlagSet;
  1517.     bfl : BobFlagSet;
  1518.  
  1519. BEGIN
  1520.   fl:=VSpriteFlagSet{};
  1521.   bfl:=BobFlagSet{};
  1522.   IF saveBackground IN flags THEN
  1523.     INCL(fl,saveBack);
  1524.   END;
  1525.   IF transparent IN flags THEN
  1526.     INCL(fl,overlay);
  1527.   END;
  1528.   vsp:=GetGel(rp,x,y,w,h,d,fl,bfl,hit,me,NIL,drp,dx,dy,
  1529.        (doubleBuffering IN flags),(animBob IN flags),NOT (noImage IN flags),
  1530.        buffer);
  1531.   IF vsp#NIL THEN
  1532.     RETURN vsp^.vsBob;
  1533.   ELSE
  1534.     RETURN NIL;
  1535.   END;
  1536. END GetBob;
  1537.  
  1538.  
  1539.  
  1540. PROCEDURE FreeBob(VAR bob   : BobPtr;
  1541.                       rp    : RastPortPtr;
  1542.                       vp    : ViewPortPtr;
  1543.                       view  : ViewPtr;
  1544.                       erase : BOOLEAN);
  1545.  
  1546. BEGIN
  1547.   IF bob#NIL THEN
  1548.     FreeGel(bob^.bobVSprite,rp,vp,view,erase);
  1549.   END;
  1550.   bob:=NIL;
  1551. END FreeBob;
  1552.  
  1553.  
  1554.  
  1555. PROCEDURE ChangeBitMap(rp     : RastPortPtr;
  1556.                        vp     : ViewPortPtr;
  1557.                        bitmap : BitMapPtr) : BitMapPtr;
  1558. VAR old : BitMapPtr;
  1559. BEGIN
  1560.   old:=bitmap;
  1561.   IF (rp#NIL) AND (vp#NIL) AND (bitmap#NIL) THEN
  1562.     old:=vp^.rasInfo^.bitMap;
  1563.     IF old=NIL THEN
  1564.       old:=rp^.bitMap;
  1565.     END;
  1566.     vp^.rasInfo^.bitMap:=bitmap;
  1567.     rp^.bitMap:=bitmap;
  1568.   END;
  1569.   RETURN old;
  1570. END ChangeBitMap;
  1571.  
  1572.  
  1573.  
  1574. VAR rememberGelsInfo : NewRememberPtr;
  1575.  
  1576. PROCEDURE GetGelsInfo(rp        : RastPortPtr;
  1577.                       spr       : SHORTSET;
  1578.                       minX,maxX : INTEGER;
  1579.                       minY,maxY : INTEGER) : AllGelsInfoPtr;
  1580. VAR gals  : AllGelsInfoPtr;
  1581.     gels  : GelsInfoPtr;
  1582.     va,vb : VSpritePtr;
  1583.     tt    : POINTER TO SHORTINT;
  1584. BEGIN
  1585.   gals:=NewAllocRemember(rememberGelsInfo,SIZE(AllGelsInfo),FALSE);
  1586.   IF gals#NIL THEN
  1587.     gels:=ADR(gals^.gelsInfo);
  1588.     IF gels#NIL THEN
  1589.       WITH gels^ DO
  1590.         leftmost:=minX; rightmost:=maxX;
  1591.         topmost:=minY; bottommost:=maxY;
  1592.         tt:=ADR(spr); sprRsrvd:=tt^;
  1593.         gelHead:=NewAllocRemember(rememberData,SIZE(VSprite),FALSE);
  1594.       END;
  1595.       IF gels^.gelHead#NIL THEN
  1596.         gels^.gelTail:=NewAllocRemember(rememberData,SIZE(VSprite),FALSE);
  1597.         IF gels^.gelTail#NIL THEN
  1598.           gels^.nextLine:=NewAllocRemember(rememberData,16,FALSE);
  1599.           IF gels^.nextLine#NIL THEN
  1600.             gels^.lastColor:=NewAllocRemember(rememberData,32,FALSE);
  1601.             IF gels^.lastColor#NIL THEN
  1602.               gels^.collHandler:=NewAllocRemember(rememberData,SIZE(CollTable),FALSE);
  1603.               IF gels^.collHandler#NIL THEN
  1604.                 va:=gels^.gelHead; vb:=gels^.gelTail;
  1605.                 InitGels(va,vb,gels);
  1606.                 rp^.gelsInfo:=gels;
  1607.               ELSE
  1608.                 FreeGelsInfo(gals);
  1609.               END;
  1610.             ELSE
  1611.               FreeGelsInfo(gals);
  1612.             END;
  1613.           ELSE
  1614.             FreeGelsInfo(gals);
  1615.           END;
  1616.         ELSE
  1617.           FreeGelsInfo(gals);
  1618.         END;
  1619.       ELSE
  1620.         FreeGelsInfo(gals);
  1621.       END;
  1622.     END;
  1623.   END;
  1624.   RETURN gals;
  1625. END GetGelsInfo;
  1626.  
  1627.  
  1628.  
  1629. PROCEDURE SetGelsInfo(rp          : RastPortPtr;
  1630.                       allGelsInfo : AllGelsInfoPtr);
  1631. BEGIN
  1632.   IF rp#NIL THEN
  1633.     rp^.gelsInfo:=ADR(allGelsInfo^.gelsInfo);
  1634.   END;
  1635. END SetGelsInfo;
  1636.  
  1637.  
  1638.  
  1639. PROCEDURE FreeGelsInfo(VAR allGelsInfo : AllGelsInfoPtr);
  1640. VAR gelsinfo : GelsInfoPtr;
  1641. BEGIN
  1642.   IF allGelsInfo#NIL THEN
  1643.     gelsinfo:=ADR(allGelsInfo^.gelsInfo);
  1644.     WITH gelsinfo^ DO
  1645.       CutRememberStructure(rememberData,collHandler,TRUE);
  1646.       CutRememberStructure(rememberData,lastColor,TRUE);
  1647.       CutRememberStructure(rememberData,nextLine,TRUE);
  1648.       CutRememberStructure(rememberData,gelTail,TRUE);
  1649.       CutRememberStructure(rememberData,gelHead,TRUE);
  1650.     END;
  1651.     CutRememberStructure(rememberGelsInfo,allGelsInfo,TRUE);
  1652.   END;
  1653.   allGelsInfo:=NIL;
  1654. END FreeGelsInfo;
  1655.  
  1656.  
  1657.  
  1658. VAR agi        : AllGelsInfoPtr;
  1659.  
  1660.  
  1661. (*$ EntryExitCode:=FALSE *)
  1662. PROCEDURE BorderHandler(coll{0}     : CollisionBorderSet;
  1663.                         vsprite{11} : VSpritePtr);
  1664. BEGIN
  1665.   ASSEMBLE(RELOCATION
  1666.            MOVEM.L D0-D7/A0-A6,-(SP)
  1667.            MOVEM.L D0-D1/A0-A1,-(SP)
  1668.            MOVE.L #0,A1
  1669.            MOVE.L 4,A6
  1670.            JSR FindTask(A6)
  1671.            MOVE.L D0,A0
  1672.            MOVE.L Task.userData(A0),A4
  1673.            MOVEM.L (SP)+,D0-D1/A0-A1
  1674.   END);
  1675.  
  1676.   agi^.borderProc(vsprite,coll);
  1677.  
  1678.   ASSEMBLE(MOVEM.L (SP)+,D0-D7/A0-A6
  1679.            RTS
  1680.   END);
  1681. END BorderHandler;
  1682.  
  1683.  
  1684.  
  1685. PROCEDURE SetBorderCollisionProcedure(proc        : BorderCollProc;
  1686.                                       allGelsInfo : AllGelsInfoPtr);
  1687. BEGIN
  1688.   IF allGelsInfo#NIL THEN
  1689.     allGelsInfo^.borderProc:=proc;
  1690.     SetCollision(0,CAST(PROC,ADR(BorderHandler)),ADR(allGelsInfo^.gelsInfo));
  1691.   END;
  1692. END SetBorderCollisionProcedure;
  1693.  
  1694.  
  1695.  
  1696. (*$ EntryExitCode:=FALSE *)
  1697. PROCEDURE GelsHandler(vsprb{10} : VSpritePtr;
  1698.                       vspra{2}  : VSpritePtr);
  1699. VAR nr{1} : INTEGER;
  1700. BEGIN
  1701.   ASSEMBLE(RELOCATION
  1702.            MOVEM.L D0-D7/A0-A6,-(SP)
  1703.            LEA l2,A0
  1704.            MOVEQ #1,D1
  1705.            JMP jump(PC)
  1706.        l2: MOVEM.L D0-D7/A0-A6,-(SP)
  1707.            LEA l3,A0
  1708.            MOVEQ #2,D1
  1709.            JMP jump(PC)
  1710.        l3: MOVEM.L D0-D7/A0-A6,-(SP)
  1711.            LEA l4,A0
  1712.            MOVEQ #3,D1
  1713.            JMP jump(PC)
  1714.        l4: MOVEM.L D0-D7/A0-A6,-(SP)
  1715.            LEA l5,A0
  1716.            MOVEQ #4,D1
  1717.            JMP jump(PC)
  1718.        l5: MOVEM.L D0-D7/A0-A6,-(SP)
  1719.            LEA l6,A0
  1720.            MOVEQ #5,D1
  1721.            JMP jump(PC)
  1722.        l6: MOVEM.L D0-D7/A0-A6,-(SP)
  1723.            LEA l7,A0
  1724.            MOVEQ #6,D1
  1725.            JMP jump(PC)
  1726.        l7: MOVEM.L D0-D7/A0-A6,-(SP)
  1727.            LEA l8,A0
  1728.            MOVEQ #7,D1
  1729.            JMP jump(PC)
  1730.        l8: MOVEM.L D0-D7/A0-A6,-(SP)
  1731.            LEA l9,A0
  1732.            MOVEQ #8,D1
  1733.            JMP jump(PC)
  1734.        l9: MOVEM.L D0-D7/A0-A6,-(SP)
  1735.            LEA la,A0
  1736.            MOVEQ #9,D1
  1737.            JMP jump(PC)
  1738.        la: MOVEM.L D0-D7/A0-A6,-(SP)
  1739.            LEA lb,A0
  1740.            MOVEQ #10,D1
  1741.            JMP jump(PC)
  1742.        lb: MOVEM.L D0-D7/A0-A6,-(SP)
  1743.            LEA lc,A0
  1744.            MOVEQ #11,D1
  1745.            JMP jump(PC)
  1746.        lc: MOVEM.L D0-D7/A0-A6,-(SP)
  1747.            LEA ld,A0
  1748.            MOVEQ #12,D1
  1749.            JMP jump(PC)
  1750.        ld: MOVEM.L D0-D7/A0-A6,-(SP)
  1751.            LEA le,A0
  1752.            MOVEQ #13,D1
  1753.            JMP jump(PC)
  1754.        le: MOVEM.L D0-D7/A0-A6,-(SP)
  1755.            LEA lf,A0
  1756.            MOVEQ #14,D1
  1757.            JMP jump(PC)
  1758.        lf: MOVEM.L D0-D7/A0-A6,-(SP)
  1759.            MOVEQ #15,D1
  1760.   jump:
  1761.            MOVEM.L D0-D1/A0-A1,-(SP)
  1762.            MOVE.L #0,A1
  1763.            MOVE.L 4,A6
  1764.            JSR FindTask(A6)
  1765.            MOVE.L D0,A0
  1766.            MOVE.L Task.userData(A0),A4
  1767.            MOVEM.L (SP)+,D0-D1/A0-A1
  1768.   END);
  1769.  
  1770.   agi^.gelsProc[nr](vspra,vsprb);
  1771.   ASSEMBLE(MOVEM.L (SP)+,D0-D7/A0-A6
  1772.            RTS
  1773.   END);
  1774. END GelsHandler;
  1775.  
  1776.  
  1777.  
  1778. PROCEDURE SetGelsCollisionProcedure(num         : LONGCARD;
  1779.                                     proc        : GelsCollProc;
  1780.                                     allGelsInfo : AllGelsInfoPtr);
  1781. VAR adr : ADDRESS;
  1782. BEGIN
  1783.   IF (num>=1) AND (num<=15) AND (allGelsInfo#NIL) THEN
  1784.     allGelsInfo^.gelsProc[num]:=proc;
  1785.     adr:=ADR(GelsHandler); INC(adr,(num-1)*16);
  1786.     SetCollision(num,CAST(PROC,adr),ADR(allGelsInfo^.gelsInfo));
  1787.   END;
  1788. END SetGelsCollisionProcedure;
  1789.  
  1790.  
  1791.  
  1792. PROCEDURE TestCollision(rp : RastPortPtr);
  1793. VAR task : TaskPtr;
  1794. BEGIN
  1795.   IF rp#NIL THEN
  1796.     agi:=ADDRESS(rp^.gelsInfo);
  1797.     IF agi#NIL THEN
  1798.       task:=FindTask(NIL);
  1799.       IF task#NIL THEN task^.userData:=REG(12); END;
  1800.       DoCollision(rp);
  1801.     END;
  1802.   END;
  1803. END TestCollision;
  1804.  
  1805.  
  1806. VAR rememberAnimation : NewRememberPtr;
  1807.     rememberComp      : NewRememberPtr;
  1808.  
  1809. PROCEDURE InitAnim() : AnimPtr;
  1810. VAR ao  : AnimPtr;
  1811.     x,y : INTEGER;
  1812. BEGIN
  1813.   ao:=NewAllocRemember(rememberAnimation,SIZE(Anim),FALSE);
  1814.   IF ao#NIL THEN
  1815.     WITH ao^.animOb DO
  1816.       nextOb:=NIL; prevOb:=NIL; clock:=0; anX:=-256*64; anY:=-256*64;
  1817.       xAccel:=0; yAccel:=0; xVel:=0; yVel:=0; ringXTrans:=0; ringYTrans:=0;
  1818.       animORoutine:=NIL; headComp:=NIL;
  1819.     END;
  1820.   END;
  1821.   RETURN ao;
  1822. END InitAnim;
  1823.  
  1824.  
  1825.  
  1826. PROCEDURE AddAnimBob(anim  : AnimPtr;
  1827.                      bob   : BobPtr;
  1828.                      time  : INTEGER;
  1829.                      xt,yt : FFP);
  1830. VAR animc : AnimCompPtr;
  1831. BEGIN
  1832.   IF (anim#NIL) AND (bob#NIL) THEN
  1833.     IF anim^.firstComp#NIL THEN
  1834.       animc:=anim^.firstComp;
  1835.       WHILE animc^.nextSeq#NIL DO animc:=animc^.nextSeq; END;
  1836.       animc^.nextSeq:=NewAllocRemember(rememberComp,SIZE(AnimComp),FALSE);
  1837.       IF animc^.nextSeq#NIL THEN animc^.nextSeq^.prevSeq:=animc; END;
  1838.       animc:=animc^.nextSeq;
  1839.     ELSE
  1840.       anim^.firstComp:=NewAllocRemember(rememberComp,SIZE(AnimComp),FALSE);
  1841.       animc:=anim^.firstComp;
  1842.     END;
  1843.     IF animc#NIL THEN
  1844.       WITH animc^ DO
  1845.         flags:=ringtrigger; prevComp:=NIL; nextComp:=NIL;
  1846.         timeSet:=time; yTrans:=TRUNC(yt*64.0)+256*64;
  1847.         xTrans:=TRUNC(xt*64.0)+256*64;
  1848.         animCRoutine:=NIL; headOb:=ADR(anim^.animOb);
  1849.         IF bob#NIL THEN
  1850.           INCL(bob^.flags,bobIsComp); bob^.bobComp:=animc;
  1851.         END;
  1852.         animBob:=bob;
  1853.       END;
  1854.     END;
  1855.   END;
  1856. END AddAnimBob;
  1857.  
  1858.  
  1859.  
  1860. PROCEDURE EndAnimDefinition(VAR list : AnimPtr;
  1861.                                 anim : AnimPtr;
  1862.                                 rp   : RastPortPtr;
  1863.                                 proc : AnimProc);
  1864. VAR animc : AnimCompPtr;
  1865.     aanim : AnimPtr;
  1866.     a1,a2 : AnimObPtr;
  1867.     b1,b2 : ADDRESS;
  1868.     nb    : NewBobPtr;
  1869. BEGIN
  1870.   IF (anim#NIL) AND (rp#NIL) THEN
  1871.     IF anim^.firstComp#NIL THEN
  1872.       animc:=anim^.firstComp;
  1873.       WHILE animc^.nextSeq#NIL DO
  1874.         nb:=ADDRESS(animc^.animBob); nb^.user:=bobAdded;
  1875.         animc:=animc^.nextSeq;
  1876.       END;
  1877.       nb:=ADDRESS(animc^.animBob); nb^.user:=bobAdded;
  1878.       animc^.nextSeq:=anim^.firstComp;
  1879.       anim^.firstComp^.prevSeq:=animc;
  1880.       anim^.animOb.headComp:=anim^.firstComp;
  1881.       anim^.animProc:=proc;
  1882.       IF list=NIL THEN
  1883.         a1:=ADR(anim^.animOb); a2:=NIL;
  1884.         AddAnimOb(a1,a2,rp);
  1885.         list:=anim;
  1886.       ELSE
  1887.         a1:=ADR(anim^.animOb); a2:=ADR(list^.animOb);
  1888.         AddAnimOb(a1,a2,rp);
  1889.         aanim:=list;
  1890.         WHILE aanim^.next#NIL DO
  1891.           aanim:=aanim^.next;
  1892.         END;
  1893.         aanim^.next:=anim;
  1894.         aanim^.next^.prev:=aanim;
  1895.       END;
  1896.       list^.rp:=rp;
  1897.     END;
  1898.   END;
  1899. END EndAnimDefinition;
  1900.  
  1901.  
  1902.  
  1903. PROCEDURE ChangeComp(anim  : AnimPtr;
  1904.                      bob   : BobPtr;
  1905.                      time  : INTEGER;
  1906.                      xt,yt : FFP);
  1907. VAR rem   : NewRememberPtr;
  1908.     aanim : AnimPtr;
  1909.     animc : AnimCompPtr;
  1910. BEGIN
  1911.   IF (anim#NIL) AND (bob#NIL) THEN
  1912.     rem:=rememberComp;
  1913.     WHILE rem#NIL DO
  1914.       aanim:=GetAddress(rem);
  1915.       animc:=anim^.firstComp;
  1916.       WHILE animc#NIL DO
  1917.         IF animc^.animBob=bob THEN
  1918.           animc^.timeSet:=time; animc^.yTrans:=TRUNC(yt*64.0)+256*64;
  1919.           animc^.xTrans:=TRUNC(xt*64.0)+256*64;
  1920.         END;
  1921.         animc:=animc^.nextSeq;
  1922.       END;
  1923.       rem:=rem^.next;
  1924.     END;
  1925.   END;
  1926. END ChangeComp;
  1927.  
  1928.  
  1929.  
  1930. PROCEDURE SetAnim(anim  : AnimPtr;
  1931.                   px,py : FFP;
  1932.                   vx,vy : FFP;
  1933.                   ax,ay : FFP);
  1934. VAR x,y : INTEGER;
  1935. BEGIN
  1936.   IF anim#NIL THEN
  1937.     WITH anim^.animOb DO
  1938.       anX:=TRUNC(px*64.0)-256*64; anY:=TRUNC(py*64.0)-256*64;
  1939.       xVel:=TRUNC(vx*64.0); xAccel:=TRUNC(ax*64.0);
  1940.       yVel:=TRUNC(vy*64.0); yAccel:=TRUNC(ay*64.0);
  1941.     END;
  1942.   END;
  1943. END SetAnim;
  1944.  
  1945.  
  1946.  
  1947. PROCEDURE GetActualVelocity(anim      : AnimPtr;
  1948.                             VAR vx,vy : FFP);
  1949. BEGIN
  1950.   IF anim#NIL THEN
  1951.     vx:=FFP(anim^.animOb.xVel)/64.0;
  1952.     vy:=FFP(anim^.animOb.yVel)/64.0;
  1953.   END;
  1954. END GetActualVelocity;
  1955.  
  1956.  
  1957.  
  1958. PROCEDURE GetActualPosition(anim      : AnimPtr;
  1959.                             VAR px,py : FFP);
  1960. BEGIN
  1961.   IF anim#NIL THEN
  1962.     px:=FFP(anim^.animOb.anX)/64.0+256.0;
  1963.     py:=FFP(anim^.animOb.anY)/64.0+256.0;
  1964.   END;
  1965. END GetActualPosition;
  1966.  
  1967.  
  1968.  
  1969. PROCEDURE AnimObjects(list : AnimPtr);
  1970. VAR anim  : AnimPtr;
  1971.     animc : AnimObPtr;
  1972. BEGIN
  1973.   IF list#NIL THEN
  1974.     anim:=list;
  1975.     WHILE anim#NIL DO
  1976.       IF anim^.animProc#NIL THEN anim^.animProc(anim); END;
  1977.       anim:=anim^.next;
  1978.     END;
  1979.     animc:=ADR(list^.animOb);
  1980.     Animate(animc,list^.rp);
  1981.   END;
  1982. END AnimObjects;
  1983.  
  1984.  
  1985.  
  1986. PROCEDURE FreeAnim(VAR anim : AnimPtr);
  1987. VAR animc,next : AnimCompPtr;
  1988. BEGIN
  1989.   IF anim#NIL THEN
  1990.     WITH anim^.animOb DO
  1991.       IF prevOb#NIL THEN prevOb^.nextOb:=nextOb; END;
  1992.       IF nextOb#NIL THEN nextOb^.prevOb:=prevOb; END;
  1993.     END;
  1994.     animc:=anim^.firstComp;
  1995.     IF animc#NIL THEN
  1996.       REPEAT
  1997.         next:=animc^.nextSeq;
  1998.         CutRememberStructure(rememberComp,animc,TRUE);
  1999.         animc:=next;
  2000.       UNTIL (animc=NIL) OR (animc=anim^.firstComp);
  2001.     END;
  2002.     CutRememberStructure(rememberAnimation,anim,TRUE);
  2003.   END;
  2004.   anim:=NIL;
  2005. END FreeAnim;
  2006.  
  2007.  
  2008.  
  2009. CONST WC = 180.0/3.1415926536;
  2010.  
  2011. VAR rememberTurtle : NewRememberPtr;
  2012.  
  2013. PROCEDURE InitTurtleGraphics(rp : RastPortPtr) : TurtleHandlePtr;
  2014. VAR t : TurtleHandlePtr;
  2015. BEGIN
  2016.   IF rp#NIL THEN
  2017.     t:=NewAllocRemember(rememberTurtle,SIZE(TurtleHandle),FALSE);
  2018.     IF t#NIL THEN
  2019.       t^.rp:=rp;
  2020.       WITH t^ DO
  2021.         x:=FFP(4*rp^.bitMap^.bytesPerRow);
  2022.         y:=FFP(rp^.bitMap^.rows/2);
  2023.         actAngle:=0; penUp:=FALSE; cursorOn:=TRUE;
  2024.       END;
  2025.       DrawCursor(t);
  2026.     END;
  2027.   END;
  2028.   RETURN t;
  2029. END InitTurtleGraphics;
  2030.  
  2031.  
  2032.  
  2033. PROCEDURE SetTurtleRast(t  : TurtleHandlePtr;
  2034.                         c  : INTEGER);
  2035. BEGIN
  2036.   IF t#NIL THEN
  2037.     WITH t^ DO
  2038.       IF rp#NIL THEN
  2039.         SetRast(rp,c);
  2040.       END;
  2041.       IF cursorOn THEN
  2042.         DrawCursor(t);
  2043.       END;
  2044.     END;
  2045.   END;
  2046. END SetTurtleRast;
  2047.  
  2048.  
  2049.  
  2050. PROCEDURE DrawCursor(t : TurtleHandlePtr);
  2051. VAR d : DrawModeSet;
  2052.     w : FFP;
  2053.     mx1,mx2,mx3,mx4,my1,my2,my3,my4 : INTEGER;
  2054. BEGIN
  2055.   IF t#NIL THEN
  2056.     WITH t^ DO
  2057.       d:=rp^.drawMode;
  2058.       SetDrMd(rp,DrawModeSet{complement});
  2059.       mx4:=TRUNC(x); my4:=TRUNC(y);
  2060.       w:=FFP(actAngle)/WC;
  2061.       mx1:=TRUNC(x-10.0*Sin(w));
  2062.       my1:=TRUNC(y-10.0*Cos(w));
  2063.       w:=FFP(actAngle+120)/WC;
  2064.       mx2:=TRUNC(x-8.0*Sin(w));
  2065.       my2:=TRUNC(y-8.0*Cos(w));
  2066.       w:=FFP(actAngle-120)/WC;
  2067.       mx3:=TRUNC(x-8.0*Sin(w));
  2068.       my3:=TRUNC(y-8.0*Cos(w));
  2069.       Move(rp,mx4,my4);
  2070.       Draw(rp,mx3,my3);
  2071.       Draw(rp,mx1,my1);
  2072.       Draw(rp,mx2,my2);
  2073.       Draw(rp,mx4,my4);
  2074.       SetDrMd(rp,d);
  2075.     END;
  2076.   END;
  2077. END DrawCursor;
  2078.  
  2079.  
  2080.  
  2081. PROCEDURE Forward(t : TurtleHandlePtr;
  2082.                   m : INTEGER);
  2083. VAR w,f   : FFP;
  2084.     xi,yi : INTEGER;
  2085. BEGIN
  2086.   IF t#NIL THEN
  2087.     WITH t^ DO
  2088.       xi:=TRUNC(x); yi:=TRUNC(y);
  2089.       Move(rp,xi,yi);
  2090.       IF cursorOn THEN DrawCursor(t); END;
  2091.       f:=FFP(m);
  2092.       w:=FFP(actAngle)/WC;
  2093.       x:=x-f*Sin(w);
  2094.       y:=y-f*Cos(w);
  2095.       IF NOT penUp THEN
  2096.         xi:=TRUNC(x); yi:=TRUNC(y);
  2097.         Draw(rp,xi,yi);
  2098.       END;
  2099.       IF cursorOn THEN DrawCursor(t); END;
  2100.     END;
  2101.   END;
  2102. END Forward;
  2103.  
  2104.  
  2105.  
  2106. PROCEDURE Backward(t : TurtleHandlePtr;
  2107.                    m : INTEGER);
  2108. BEGIN
  2109.   Forward(t,-m);
  2110. END Backward;
  2111.  
  2112.  
  2113.  
  2114. PROCEDURE Right(t : TurtleHandlePtr;
  2115.                 w : INTEGER);
  2116. BEGIN
  2117.   IF t#NIL THEN
  2118.     WITH t^ DO
  2119.       IF cursorOn THEN DrawCursor(t); END;
  2120.       actAngle:=(actAngle+360+w) MOD 360;
  2121.       IF cursorOn THEN DrawCursor(t); END;
  2122.     END;
  2123.   END;
  2124. END Right;
  2125.  
  2126.  
  2127.  
  2128. PROCEDURE Left(t : TurtleHandlePtr;
  2129.                w : INTEGER);
  2130. BEGIN
  2131.   Right(t,-w);
  2132. END Left;
  2133.  
  2134.  
  2135.  
  2136. PROCEDURE Home(t : TurtleHandlePtr);
  2137. BEGIN
  2138.   IF t#NIL THEN
  2139.     WITH t^ DO
  2140.       IF cursorOn THEN DrawCursor(t); END;
  2141.       x:=FFP(4*rp^.bitMap^.bytesPerRow);
  2142.       y:=FFP(rp^.bitMap^.rows/2);
  2143.       actAngle:=0;
  2144.       IF cursorOn THEN DrawCursor(t); END;
  2145.     END;
  2146.   END;
  2147. END Home;
  2148.  
  2149.  
  2150.  
  2151. PROCEDURE PenUp(t : TurtleHandlePtr);
  2152. BEGIN
  2153.   IF t#NIL THEN
  2154.     t^.penUp:=TRUE;
  2155.   END;
  2156. END PenUp;
  2157.  
  2158.  
  2159.  
  2160. PROCEDURE PenDown(t : TurtleHandlePtr);
  2161. BEGIN
  2162.   IF t#NIL THEN
  2163.     t^.penUp:=FALSE;
  2164.   END;
  2165. END PenDown;
  2166.  
  2167.  
  2168.  
  2169. PROCEDURE TurtleCursor(t  : TurtleHandlePtr;
  2170.                        on : BOOLEAN);
  2171. BEGIN
  2172.   IF t#NIL THEN
  2173.     IF on#t^.cursorOn THEN
  2174.       DrawCursor(t);
  2175.       t^.cursorOn:=on;
  2176.     END;
  2177.   END;
  2178. END TurtleCursor;
  2179.  
  2180.  
  2181.  
  2182. PROCEDURE FreeTurtleGraphics(VAR t : TurtleHandlePtr);
  2183. BEGIN
  2184.   IF t#NIL THEN
  2185.     WITH t^ DO
  2186.       IF cursorOn THEN DrawCursor(t); END;
  2187.     END;
  2188.     CutRememberStructure(rememberTurtle,t,TRUE);
  2189.   END;
  2190.   t:=NIL;
  2191. END FreeTurtleGraphics;
  2192.  
  2193.  
  2194.  
  2195. VAR rem : NewRememberPtr;
  2196.     vs  : VSpritePtr;
  2197.     rt  : RasterPtr;
  2198.     sp  : SpriteHandlePtr;
  2199.     bm  : BitMapPtr;
  2200.     vw  : ViewHandlePtr;
  2201.     gi  : AllGelsInfoPtr;
  2202.     ai  : SAreaHandlePtr;
  2203.     an  : AnimPtr;
  2204.  
  2205. BEGIN
  2206.  
  2207.   gfxBase:=ADR(GraphicsL);
  2208.  
  2209. CLOSE
  2210.  
  2211.   rem:=rememberSprite;
  2212.   WHILE rem#NIL DO
  2213.     sp:=GetAddress(rem);
  2214.     RemSprite(sp);
  2215.     rem:=rem^.next;
  2216.   END;
  2217.   NewFreeRemember(rememberSprite,TRUE);
  2218.  
  2219.   rem:=rememberVSprite;
  2220.   WHILE rem#NIL DO
  2221.     vs:=GetAddress(rem);
  2222.     FreeGel(vs,NIL,NIL,NIL,FALSE);
  2223.     rem:=rem^.next;
  2224.   END;
  2225.   NewFreeRemember(rememberVSprite,TRUE);
  2226.  
  2227.   rem:=rememberAnimation;
  2228.   WHILE rem#NIL DO
  2229.     an:=GetAddress(rem);
  2230.     FreeAnim(an);
  2231.     rem:=rem^.next;
  2232.   END;
  2233.   NewFreeRemember(rememberAnimation,TRUE);
  2234.  
  2235.   rem:=rememberGelsInfo;
  2236.   WHILE rem#NIL DO
  2237.     gi:=GetAddress(rem);
  2238.     FreeGelsInfo(gi);
  2239.     rem:=rem^.next;
  2240.   END;
  2241.   NewFreeRemember(rememberGelsInfo,TRUE);
  2242.  
  2243.   rem:=rememberView;
  2244.   WHILE rem#NIL DO
  2245.     vw:=GetAddress(rem);
  2246.     FreeView(vw);
  2247.     rem:=rem^.next;
  2248.   END;
  2249.   NewFreeRemember(rememberView,TRUE);
  2250.  
  2251.   rem:=rememberRaster;
  2252.   WHILE rem#NIL DO
  2253.     rt:=GetAddress(rem);
  2254.     FreeTmpRas(rt);
  2255.     rem:=rem^.next;
  2256.   END;
  2257.   NewFreeRemember(rememberRaster,TRUE);
  2258.  
  2259.   rem:=rememberBitmap;
  2260.   WHILE rem#NIL DO
  2261.     bm:=GetAddress(rem);
  2262.     FreeBitMap(bm);
  2263.     rem:=rem^.next;
  2264.   END;
  2265.   NewFreeRemember(rememberBitmap,TRUE);
  2266.  
  2267.   NewFreeRemember(rememberData,TRUE);
  2268.   NewFreeRemember(rememberComp,TRUE);
  2269.   NewFreeRemember(rememberTurtle,TRUE);
  2270.  
  2271. END GraphicsSupport.
  2272.